﻿Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging
Imports System.Drawing
Imports System.Runtime.Serialization.Formatters.Binary
Imports System.IO

Module sAPI
    Public Const SC_MOVE = &HF012
    Public Const SC_NCLBUTTONDOWN = &HA1
    Public Const HTCAPTION = 2
    Public Const WM_SYSCOMMAND = &H112
    Public Const WM_MOVING = &H216
    Public Const WM_MOVE = &H3
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
    Public Structure RECT
        Public Left As Integer
        Public Top As Integer
        Public Right As Integer
        Public Bottom As Integer
    End Structure
    '获得整个窗口的范围矩形，窗口的边框、标题栏、滚动条及菜单等都在这个矩形内
    <DllImport("user32", EntryPoint:="GetWindowRect", SetLastError:=False, _
    CharSet:=CharSet.Auto, ExactSpelling:=False, _
    CallingConvention:=CallingConvention.StdCall)> _
        Public Function GetWindowRect _
                      (ByVal hWnd As IntPtr, _
                       ByRef lpRect As RECT) As Integer
    End Function

    <DllImport("user32.dll", EntryPoint:="SendMessage")> _
    Public Function SendMessage(ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    End Function
    <DllImport("user32.dll", EntryPoint:="ReleaseCapture")> _
    Public Function ReleaseCapture() As Integer
    End Function
    '暂停线索
    <DllImport("kernel32", EntryPoint:="Sleep", SetLastError:=False, _
    CharSet:=CharSet.Auto, ExactSpelling:=False, _
    CallingConvention:=CallingConvention.StdCall)> _
        Public Sub Sleep _
                      (ByVal dwMilliseconds As Integer)
    End Sub

    Public Declare Function WritePrivateProfileString Lib "kernel32" _
           Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
                                               ByVal lpKeyName As String, _
                                               ByVal lpString As String, _
                                               ByVal lpFileName As String) As Integer
    '为初始化文件中指定的条目取得字串
    Public Declare Function GetPrivateProfileString Lib "kernel32" _
                   Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
                                                     ByVal lpKeyName As String, _
                                                     ByVal lpDefault As String, _
                                                     ByVal lpReturnedString As String, _
                                                     ByVal nSize As Integer, _
                                                     ByVal lpFileName As String) As Integer
    '指定一个窗口的新父（在vb里使用：利用这个函数，vb可以多种形式支持子窗口。例如，可将控件从一个容器移至窗体中的另一个。用这个函数在窗体间移动控件是相当冒险的，但却不失为一个有效的办法。如真的这样做，请在关闭任何一个窗体之前，注意用SetParent将控件的父设回原来的那个）
    <DllImport("user32", EntryPoint:="SetParent", SetLastError:=False, _
    CharSet:=CharSet.Auto, ExactSpelling:=False, _
    CallingConvention:=CallingConvention.StdCall)> _
        Public Function SetParent _
                       (ByVal hWndChild As Integer, _
                        ByVal hWndNewParent As Integer) As Integer
    End Function
    Public Enum ENUMMOUSEEVENT
        ''' <summary>
        ''' 常规状态
        ''' </summary>
        ''' <remarks></remarks>
        MOUSENORMAL = 0
        ''' <summary>
        ''' 鼠标经过
        ''' </summary>
        ''' <remarks></remarks>
        MOUSEHOVER = 1
        ''' <summary>
        ''' 鼠标按下
        ''' </summary>
        ''' <remarks></remarks>
        MOUSEDOWN = 2
        ''' <summary>
        ''' 鼠标放开
        ''' </summary>
        ''' <remarks></remarks>
        MOUSEUP = 3
        ''' <summary>
        ''' 鼠标离开
        ''' </summary>
        ''' <remarks></remarks>
        MOUSELEAVE = 4
    End Enum
    ''' <summary>
    ''' 反序列化byte数据
    ''' </summary>
    ''' <param name="Bin">字节型数组数据</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function BinToCmd(ByVal Bin() As Byte) As Object
        If Bin.Length <= 0 Then Return Nothing
        If (Not Bin Is Nothing) Then
            Dim Formatter As New BinaryFormatter                                        '定义序列化对象
            Dim StreamTemp As MemoryStream, Cmd As Object
            Try
                StreamTemp = New MemoryStream(Bin)                                     '数组->内存流
                Cmd = CType(Formatter.Deserialize(StreamTemp), Object)    '内存流->对象
            Catch ex As Exception
                Throw New Exception(ex.Message, ex)
            End Try
            Try
                StreamTemp.Close()
                Return Cmd
            Catch
                Return Nothing
            End Try
        Else
            Return Nothing
        End If
    End Function
    ''' <summary>
    ''' 对象、结构体转换成byte，字节型数据
    ''' </summary>
    ''' <param name="Cmd">对象</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function CmdToBin(ByVal Cmd As Object) As Byte()
        Dim StreamTemp As New MemoryStream                                             '定义流对象
        Dim Formatter As New BinaryFormatter
        Try
            Formatter.Serialize(StreamTemp, Cmd)                                           '对象->内存流
            StreamTemp.Close()
            Return StreamTemp.GetBuffer()
        Catch ex As Exception '内存流->数组
            Throw New Exception(ex.Message)
        End Try
    End Function
    Public Function GetIniValue(ByVal fpName As String, ByVal Node As String, ByVal mFileName As String) As String
        Dim Str As String = ""
        Dim lpDefault As String = ""
        Str = LSet(Str, 256)
        GetPrivateProfileString(fpName, Node, lpDefault, Str, Len(Str), mFileName)
        Return Microsoft.VisualBasic.Left(Str, InStr(Str, Chr(0)) - 1)
    End Function
    Public Function WriteIniValue(ByVal fpName As String, ByVal Node As String, ByVal NodeValue As String, ByVal IniFile As String) As Integer
        Try
            WritePrivateProfileString(fpName, Node, NodeValue, IniFile)
            Return 1
        Catch
            Return -1
        End Try
    End Function
    Public Function getNoParentPath(ByVal mFileName As String, ByVal mParentPath As String) As String
        Dim Tmp As String
        Dim a As Integer = mParentPath.Length
        If InStrRev(mParentPath, "\") < mParentPath.Length - 1 Then mParentPath = mParentPath + "\"
        a = mParentPath.Length
        Tmp = mFileName.Substring(a)
        Return Tmp
    End Function
    Public Sub DrawBP(ByVal Forma As Object, ByVal bitmap As Bitmap, ByVal opacity As Byte)
        If bitmap.PixelFormat <> PixelFormat.Format32bppArgb Then
            Throw New ApplicationException("The bitmap must be 32ppp with alpha-channel.")
        End If
        Dim screenDc As IntPtr = Win32.GetDC(IntPtr.Zero)
        Dim memDc As IntPtr = Win32.CreateCompatibleDC(screenDc)
        Dim hBitmap As IntPtr = IntPtr.Zero
        Dim oldBitmap As IntPtr = IntPtr.Zero

        Try
            hBitmap = bitmap.GetHbitmap(Color.FromArgb(0))
            oldBitmap = Win32.SelectObject(memDc, hBitmap)
            Dim size As New Win32.Size(bitmap.Width, bitmap.Height)
            Dim pointSource As New Win32.Point(0, 0)
            Dim topPos As New Win32.Point(Forma.Left, Forma.Top)
            Dim blend As New Win32.BLENDFUNCTION()
            blend.BlendOp = Win32.AC_SRC_OVER
            blend.BlendFlags = 0
            blend.SourceConstantAlpha = opacity
            blend.AlphaFormat = Win32.AC_SRC_ALPHA

            Win32.UpdateLayeredWindow(Forma.Handle, screenDc, topPos, size, memDc, pointSource, _
            0, blend, Win32.ULW_ALPHA)
        Finally
            Win32.ReleaseDC(IntPtr.Zero, screenDc)
            If hBitmap <> IntPtr.Zero Then
                Win32.SelectObject(memDc, oldBitmap)
                Win32.DeleteObject(hBitmap)
            End If
            Win32.DeleteDC(memDc)
        End Try
    End Sub
    Public Class Win32
        Public Enum Bool
            [False] = 0
            [True]
        End Enum
        ' 本源码来自：烈火下载 http://down.liehuo.net 

        <StructLayout(LayoutKind.Sequential)> _
        Public Structure Point
            Public x As Int32
            Public y As Int32

            Public Sub New(ByVal x As Int32, ByVal y As Int32)
                Me.x = x
                Me.y = y
            End Sub
        End Structure


        <StructLayout(LayoutKind.Sequential)> _
        Public Structure Size
            Public cx As Int32
            Public cy As Int32

            Public Sub New(ByVal cx As Int32, ByVal cy As Int32)
                Me.cx = cx
                Me.cy = cy
            End Sub
        End Structure


        <StructLayout(LayoutKind.Sequential, Pack:=1)> _
        Private Structure ARGB
            Public Blue As Byte
            Public Green As Byte
            Public Red As Byte
            Public Alpha As Byte
        End Structure


        <StructLayout(LayoutKind.Sequential, Pack:=1)> _
        Public Structure BLENDFUNCTION
            Public BlendOp As Byte
            Public BlendFlags As Byte
            Public SourceConstantAlpha As Byte
            Public AlphaFormat As Byte
        End Structure


        Public Const ULW_COLORKEY As Int32 = &H1
        Public Const ULW_ALPHA As Int32 = &H2
        Public Const ULW_OPAQUE As Int32 = &H4

        Public Const AC_SRC_OVER As Byte = &H0
        Public Const AC_SRC_ALPHA As Byte = &H1


        Public Declare Auto Function UpdateLayeredWindow Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal hdcDst As IntPtr, ByRef pptDst As Point, ByRef psize As Size, ByVal hdcSrc As IntPtr, ByRef pprSrc As Point, _
        ByVal crKey As Int32, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Int32) As Bool

        Public Declare Auto Function GetDC Lib "user32.dll" (ByVal hWnd As IntPtr) As IntPtr

        <DllImport("user32.dll", ExactSpelling:=True)> _
        Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer
        End Function

        Public Declare Auto Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hDC As IntPtr) As IntPtr

        Public Declare Auto Function DeleteDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As Bool

        <DllImport("gdi32.dll", ExactSpelling:=True)> _
        Public Shared Function SelectObject(ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr
        End Function

        Public Declare Auto Function DeleteObject Lib "gdi32.dll" (ByVal hObject As IntPtr) As Bool
    End Class
End Module